COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	PROGRAM G0002,FACT
C00010 ENDMK
C⊗;
PROGRAM G0002,FACT;
TYPE
	ALLTYPS = (INTEGERTYP,REALTYP,BOOLEANTYP,CHARTYP,SYMBOLTYP);

	TERMTYPS = (VARIABLE, CONSTANTTYP, FUNAPP);

	TERM = ↑T1;

	TERMLIST = ↑TL1;

	CONSTANT = ↑C1;

	SYMBOL = ↑SYM1;

	T1 = RECORD
		CASE TTYP:TERMTYPS OF
			VARIABLE: (VR: INTEGER);
			CONSTANTTYP: (CNST: CONSTANT);
			FUNAPP: (FNAME: SYMBOL;
				 ARGS: TERMLIST)
		END;

	TL1 = RECORD
		NOTEMPTY: BOOLEAN;
		FIRST: TERM;
		REST: TERMLIST
		END;

	C1 = RECORD
		CASE CTYP:ALLTYPS OF
			INTEGERTYP: (IVAL: INTEGER);
			REALTYP: (RVAL: REAL);
			BOOLEANTYP: (BVAL: BOOLEAN);
			CHARTYP: (CVAL: CHAR);
			SYMBOLTYP: (SVAL: SYMBOL)
		END;

	SYM1 = RECORD
		NOTEMPTY: BOOLEAN;
		FIRSTCH: CHAR;
		TAIL: SYMBOL;
		END;

	VARPAIRS = ↑VP;

	VP = RECORD
		NOTEMPTY: BOOLEAN;
		OLD: INTEGER;
		NEW: INTEGER;
		REST: VARPAIRS
		END;

FUNCTION GREATEREQUAL(X, Y: TERM; VAR Z: TERM): BOOLEAN;
	EXTERN;
FUNCTION SUB1(X: TERM; VAR Y: TERM): BOOLEAN;
	EXTERN;
FUNCTION TIMES(X, Y: TERM; VAR Z: TERM): BOOLEAN;
	EXTERN;
FUNCTION OCCUR(X, Y: TERM): BOOLEAN;
	EXTERN;
FUNCTION GENVAR: INTEGER;
	EXTERN;
PROCEDURE REPLACE(X, T: TERM; VAR TML: TERMLIST);
	EXTERN;
PROCEDURE SUBST(X, T: TERM; VAR T1, T2: TERMLIST);
	EXTERN;
FUNCTION EQSYM(X, Y: SYMBOL): BOOLEAN;
	EXTERN;
FUNCTION EQCONST(X, Y: CONSTANT): BOOLEAN;
	EXTERN;
FUNCTION COPYSYM(OLDSYM: SYMBOL): SYMBOL;
	EXTERN;
FUNCTION COPYTERM(OLDTM: TERM): TERM;
	EXTERN;
FUNCTION COPYTERMLIST(TML: TERMLIST): TERMLIST;
	EXTERN;
FUNCTION COPYCONST(OLDCONST: CONSTANT): CONSTANT;
	EXTERN;
FUNCTION UNIFY(VAR X,Y,ALLX,ALLY:TERMLIST): BOOLEAN;
	EXTERN;
PROCEDURE LOOKUP(TM: TERM; TBL: VARPAIRS; FOUND: BOOLEAN);
	EXTERN;
PROCEDURE STANDAPART(TML: TERMLIST; VAR DONETBL: VARPAIRS);
	EXTERN;
FUNCTION FACT(X : TERM ; VAR Y : TERM): BOOLEAN;
VAR
	G0014, G0011, G0010, G0009, G0008, G0007, ACTUALS, COPYACTUALS
, MATCHLIST: TERMLIST;
	G0015, G0012, Z1, W1, W, Z, G0005, G0003: TERM;
	G0016, G0013, G0006, G0004: CONSTANT;
	DONETBL: VARPAIRS;
	FLAG, FAILED: BOOLEAN;

BEGIN
NEW(G0003);
G0003↑.TTYP := CONSTANTTYP;
NEW(G0004);
G0004↑.CTYP := INTEGERTYP;
G0004↑.IVAL := 0;
G0003↑.CNST := G0004;
NEW(G0005);
G0005↑.TTYP := CONSTANTTYP;
NEW(G0006);
G0006↑.CTYP := BOOLEANTYP;
G0006↑.BVAL := TRUE;
G0005↑.CNST := G0006;
IF (GREATEREQUAL ( X , G0003 , G0005))
THEN BEGIN
NEW(ACTUALS);
ACTUALS↑.NOTEMPTY := FALSE;
NEW(G0008);
G0008↑.NOTEMPTY := TRUE;
G0008↑.FIRST := Y;
G0008↑.REST := ACTUALS;
ACTUALS := G0008;
NEW(G0007);
G0007↑.NOTEMPTY := TRUE;
G0007↑.FIRST := X;
G0007↑.REST := ACTUALS;
ACTUALS := G0007;
COPYACTUALS := COPYTERMLIST(ACTUALS);
NEW(DONETBL);
DONETBL↑.NOTEMPTY := FALSE;
STANDAPART(COPYACTUALS, DONETBL);
NEW(MATCHLIST);
MATCHLIST↑.NOTEMPTY := FALSE;
NEW(G0014);
G0014↑.NOTEMPTY := TRUE;
NEW(G0015);
G0015↑.TTYP := CONSTANTTYP;
NEW(G0016);
G0016↑.CTYP := INTEGERTYP;
G0016↑.IVAL := 0;
G0015↑.CNST := G0016;
G0014↑.FIRST := G0015;
G0014↑.REST := MATCHLIST;
MATCHLIST := G0014;
NEW(G0011);
G0011↑.NOTEMPTY := TRUE;
NEW(G0012);
G0012↑.TTYP := CONSTANTTYP;
NEW(G0013);
G0013↑.CTYP := INTEGERTYP;
G0013↑.IVAL := 1;
G0012↑.CNST := G0013;
G0011↑.FIRST := G0012;
G0011↑.REST := MATCHLIST;
MATCHLIST := G0011;
IF UNIFY(COPYACTUALS , MATCHLIST, COPYACTUALS, MATCHLIST)
THEN BEGIN
FAILED := NOT TRUE
END
ELSE FAILED := TRUE;
COPYACTUALS := COPYTERMLIST(ACTUALS);
NEW(DONETBL);
DONETBL↑.NOTEMPTY := FALSE;
STANDAPART(COPYACTUALS, DONETBL);
NEW(MATCHLIST);
MATCHLIST↑.NOTEMPTY := FALSE;
NEW(G0010);
G0010↑.NOTEMPTY := TRUE;
NEW(W);
W↑.TTYP := VARIABLE;
W↑.VR := GENVAR;
G0010↑.FIRST := W;
G0010↑.REST := MATCHLIST;
MATCHLIST := G0010;
NEW(G0009);
G0009↑.NOTEMPTY := TRUE;
NEW(Z);
Z↑.TTYP := VARIABLE;
Z↑.VR := GENVAR;
G0009↑.FIRST := Z;
G0009↑.REST := MATCHLIST;
MATCHLIST := G0009;
IF UNIFY(COPYACTUALS , MATCHLIST, COPYACTUALS, MATCHLIST)
THEN BEGIN
NEW(W1);
W1↑.TTYP := VARIABLE;
W1↑.VR := GENVAR;
NEW(W1);
W1↑.TTYP := VARIABLE;
W1↑.VR := GENVAR;
NEW(Z1);
Z1↑.TTYP := VARIABLE;
Z1↑.VR := GENVAR;
NEW(Z1);
Z1↑.TTYP := VARIABLE;
Z1↑.VR := GENVAR;
FAILED := NOT (SUB1 ( W , W1) AND FACT ( W1 , Z1) AND TIMES ( W , Z1 , Z))
END
ELSE FAILED := TRUE;
FLAG := NOT FAILED;
FACT := FLAG;
IF FLAG
THEN BEGIN
X :=COPYACTUALS↑.FIRST;
COPYACTUALS := COPYACTUALS↑.REST;
Y :=COPYACTUALS↑.FIRST;
COPYACTUALS := COPYACTUALS↑.REST;
END
END
ELSE FACT := FALSE
END;
BEGIN	END.